GS <- mutate(GS,Date = as.Date(Date, format = "%d-%b-%y"))
GSxts <- tk_xts(GS)
## Warning in tk_xts_.data.frame(data = data, select = select, date_var =
## date_var, : Non-numeric columns being dropped: Date
## Using column `Date` for date_var.
allDates = index(GSxts)
firstDate <- min(allDates)
lastDate <- max(allDates)-30 #find the last start_date
while(!lastDate %in% allDates)
lastDate <- lastDate-1
result <- data.frame(`StartDate` = as.Date(character()), `OptionPnL` = double(), `HedgingPnL` = double(), `FinalPnL` = double(), `MaxDrawdown` = double(), `SharpeRatio` = double(),`StartPrice`= double(), `EndPrice` = double(), `AvgPrice` = double(), `AvgGrowthRate` = double(), `Volatility` = double(), `Profitability` = double())
startD <- firstDate
for(startD in firstDate:lastDate){
startD <- as.Date(startD)
if(startD %in% allDates){
endD <- startD+30
#adjust the end date backwards if end date (a calendar day) is not in the xts
while(!endD %in% allDates)
endD <- endD-1
xts_obj <- GSxts[paste(c(startD,endD),collapse = "/")]
quantity = 100
dates <- index(xts_obj)
start_date <- min(dates)
end_date <- max(dates)
start_price <- as.numeric(xts_obj[start_date, "Close"])
start_volatility <- as.numeric(xts_obj[start_date, "IV30"])
df <- tibble(Date = dates)
df$Close <- coredata(xts_obj[, "Close"])
#df$IV30 <- coredata(xts_obj[, "IV30"])
avgChange <- as.numeric(mean(xts_obj[, "PChg"],na.rm=TRUE))
r <- 0.8 / 100
X <- start_price/(exp(qnorm(0.25)*start_volatility/100*sqrt(30/365) - (r+0.5*(start_volatility/100)^2)*30/365))
#sigma = start_volatility
# Vary S and Time everyday
#S <- df$Close
#Time <- (end_date - df$Date) / 365
#GBSOption(TypeFlag, S, X, Time, r, b, sigma)@price
df_opt <- rowwise(df) %>%
#this is the premium for one unit of call option
mutate(premium = GBSOption(TypeFlag = "c",
S = Close,
X = X,
Time = as.numeric((end_date - Date) / 365),
r = r, # interest rate
b = 1.85/100, # dividend yield obtained from https://www.dividend.com/dividend-stocks/financial/investment-brokerage-national/gs-goldman-sachs/
sigma = as.numeric(start_volatility/100))@price,
#this is the delta of a call option (before negation)
delta_hedge = GBSGreeks("delta", TypeFlag = "c",
S = Close,
X = X,
Time = as.numeric((end_date - Date) / 365),
r = r,
b = 1.85/100,
sigma = as.numeric(start_volatility/100))) %>%
ungroup() %>%
#delta hedging strategy selected: SHORT CALL LONG STOCK (from BlackS Scholes formula, such strategy should approximate a long position in risk free)
mutate(Option_DoD_PnL = ifelse(Date == start_date, # On the 1st date, we count the cost of buying the option
0, #quantity*premium, #on the first day, receive the call option premium and short the option
-quantity*(premium - Lag(premium))), #if subsequently call option price rises, there is a loss
Hedging_DoD_Pnl = ifelse(Date == start_date, 0, quantity * Lag(delta_hedge) * (Close - Lag(Close))),
DoD_PnL = Option_DoD_PnL + Hedging_DoD_Pnl) %>%
mutate(PortValue = quantity*(-premium + delta_hedge*Close),
Profitability = DoD_PnL/Lag(PortValue),
PnL_to_date = cumsum(DoD_PnL),
HPnL_to_date = cumsum(Hedging_DoD_Pnl),
OPnL_to_date = cumsum(Option_DoD_PnL))
maxDrawDown <- {
xs <- df_opt$PnL_to_date
max(cummax(xs) - cummin(xs))
}
#The initial outflow of funds is the cost to buy stocks minus option premium received
#InitialInvt = (df_opt[[1,"delta_hedge"]]*df_opt[[1,"Close"]] - df_opt[[1,"premium"]])*quantity #OUTFLOW of funds
#profitability = df_opt[df_opt$Date==end_date,"PnL_to_date"]/InitialInvt
#df_opt<-mutate(df_opt, PortValue = InitialInvt + PnL_to_date, PortReturn = DoD_PnL/Lag(PortValue))
#ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Option_DoD_PnL),color = "blue") + ggtitle("option profit - TTM"))
#ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Hedging_DoD_Pnl))+ggtitle("stock profit - TTM"))
#renderTable(tail(df_opt,1))
#renderText(paste0("the Sharpe Ratio is ",round(SR,4)))
#renderText(paste0("The maximum drawdown is ", round(maxDrawDown,4)))
hedgingPnl <- as.numeric(df_opt[df_opt$Date==end_date,"HPnL_to_date"])
finalPnl <- as.numeric(df_opt[df_opt$Date==end_date,"PnL_to_date"])
optionPnl <- as.numeric(df_opt[df_opt$Date==end_date,"OPnL_to_date"])
endPrice <- as.numeric(df_opt[df_opt$Date==end_date,"Close"])
avgPrice <- as.numeric(mean(df_opt$Close,na.rm=TRUE))
volatility <- stdev(df_opt$Profitability, na.rm = TRUE)*sqrt(252) #annualised volatility
profitability <- 12*(as.numeric(tail(cumprod(na.omit(df_opt$Profitability+1)),1))-1) #annualized profitability
SR <- as.numeric((profitability-r)/volatility) # annual SR
result <- rbind(result,data.frame("StartDate" = start_date, "OptionPnL" = optionPnl, "HedgingPnL" = hedgingPnl, "FinalPnL" = finalPnl, "MaxDrawdown" = maxDrawDown, "SharpeRatio" = SR,"StartPrice"=start_price , "EndPrice" = endPrice, "AvgPrice" = avgPrice, "AvgGrowthRate" = avgChange, "Volatility" = volatility, "Profitability" = profitability))
}}
ggplotly(p = ggplot(GS) + geom_line(aes(Date, Close, label = PChg))+ggtitle("Stock Price with percentage change")) #stock close price
## Warning: Ignoring unknown aesthetics: label
ggplot(GS) + geom_density(aes(Close)) #density of close price

ggplot(result) + geom_density(aes(MaxDrawdown)) + ggtitle("distribution of max drawdown")

kable(result%>% summarise(`MDD Mean` = mean(MaxDrawdown),`MDD volatility` = stdev(MaxDrawdown, na.rm = TRUE), `MDD Median` = median(MaxDrawdown))) %>% kable_styling(bootstrap_options = c("striped","hover"))
|
MDD Mean
|
MDD volatility
|
MDD Median
|
|
162.8201
|
156.6738
|
110.0302
|
kable(result%>% summarise(`Mean Profitability` = mean(Profitability),`volatility` = stdev(Profitability, na.rm = TRUE), `Mean PnL` = mean(FinalPnL), `PnL StdDev` = stdev(FinalPnL))) %>% kable_styling(bootstrap_options = c("striped","hover"))
|
Mean Profitability
|
volatility
|
Mean PnL
|
PnL StdDev
|
|
-0.6710013
|
2.381391
|
-17.81155
|
200.1258
|
kable(result%>% summarise(`99% VAR` = -min(quantile(FinalPnL,.01),0),`95% VAR` = -min(quantile(FinalPnL,0.05),0))) %>% kable_styling(bootstrap_options = c("striped","hover"))
|
99% VAR
|
95% VAR
|
|
676.3717
|
429.1349
|
ggplot(result) + geom_density(aes(FinalPnL),color = "blue") +
geom_density(aes(OptionPnL),color = "red") +
geom_density(aes(HedgingPnL))

ggplotly(p=ggplot(result) + geom_point(aes(AvgPrice,FinalPnL, label = StartDate)) + ggtitle("avg price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
ggplotly(p=ggplot(result) + geom_point(aes(AvgGrowthRate,FinalPnL, label = AvgPrice))+ggtitle("avg growth rate - final pnl"))
## Warning: Ignoring unknown aesthetics: label
ggplotly(p=ggplot(result) + geom_point(aes(StartPrice,FinalPnL, label = EndPrice))+ggtitle("start price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
ggplotly(p=ggplot(result) + geom_point(aes(EndPrice,FinalPnL, label = StartPrice))+ggtitle("end price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
p1 <- ggplot(result) + geom_point(aes(AvgPrice, OptionPnL)) + ggtitle("avg price - option pnl") #+ xlim(150,300) + ylim(150,300) + coord_fixed(ratio = 1)
p2 <- ggplot(result) + geom_point(aes(AvgPrice, HedgingPnL)) + ggtitle("avg price - hedging pnl") #+ xlim(150,300) + ylim(150,300) + coord_fixed(ratio = 1)
grid.arrange(p1,p2,nrow = 1)

a1 <- ggplot(result) + geom_point(aes(AvgGrowthRate,OptionPnL)) +
ggtitle("avg growth rate - option pnl")
a2 <- ggplot(result) + geom_point(aes(AvgGrowthRate,HedgingPnL)) +
ggtitle("avg growth rate - hedging pnl")
grid.arrange(a1,a2, nrow = 1)
The PnLs have greater dispersion when average price or average growth rate (represented in percentage) increases. The PnL can be very extreme towards the higher end of the growth rate. Option PnL is more cluttered when growth rate is at level (-1,0.5) compared with hedging PnL at the same growth level, which suggests that the risk may not be perfectly hedged.
a3 <- ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = OptionPnL), size = 0.8, alpha = 0.7)+ggtitle("start & end price - option pnl") + xlim(150,280) + ylim(150,280) + coord_fixed(ratio = 1) + geom_abline(mapping = NULL, data = NULL, slope = 1, intercept = 0, show.legend = NA)
a4 <- ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = HedgingPnL), size = 0.8, alpha = 0.7)+ggtitle("start & end price - hedging pnl") + xlim(150,280) + ylim(150,280) + coord_fixed(ratio = 1) + geom_abline(mapping = NULL, data = NULL, slope = 1, intercept = 0, show.legend = NA)
grid.arrange(a3,a4, nrow=1)

The graph plots start and end price on x and y axis respectively, so points lying on the 45 degree line represents a trade with start price equals end price. The color represents the Option and Hedging PnL. From the color of the points, it is easy to observe the hedging relationship. When the points are below the line (decreasing price), the option PnL is more favourable (since we have a short position in the call option), and hedging PnL is more negative.
When using 0.25 delta, we get a smaller final pnl, this is because the OTM options are cheaper and we need less stocks to hedge against them. It could also be observed that the option and hedging PnLs in a single trade with 25% delta fluctuate less violently or regularly against Time to Maturity as compared to ATM options in the other backtesting.
kable(head(result,20))%>%
kable_styling(bootstrap_options = c("striped","hover"))
|
StartDate
|
OptionPnL
|
HedgingPnL
|
FinalPnL
|
MaxDrawdown
|
SharpeRatio
|
StartPrice
|
EndPrice
|
AvgPrice
|
AvgGrowthRate
|
Volatility
|
Profitability
|
|
2017-12-13
|
220.07269
|
-118.91429
|
101.158403
|
104.07377
|
8.9203529
|
255.56
|
257.03
|
256.1119
|
-0.0000952
|
0.0663122
|
0.5995284
|
|
2017-12-14
|
210.73508
|
-118.68985
|
92.045229
|
100.13937
|
8.3767367
|
255.48
|
257.03
|
256.1395
|
0.0003000
|
0.0678813
|
0.5766238
|
|
2017-12-15
|
204.73691
|
-131.04002
|
73.696886
|
85.70971
|
7.7983277
|
257.17
|
257.03
|
256.1742
|
0.0003158
|
0.0727218
|
0.5751083
|
|
2017-12-18
|
227.06058
|
-168.83876
|
58.221825
|
81.15563
|
3.7267474
|
260.02
|
253.65
|
256.1125
|
-0.0007000
|
0.0977887
|
0.3724337
|
|
2017-12-19
|
232.23490
|
-104.43415
|
127.800750
|
150.62884
|
3.0696009
|
256.48
|
250.97
|
255.6600
|
-0.0018000
|
0.0971778
|
0.3062969
|
|
2017-12-20
|
234.13694
|
-87.85054
|
146.286397
|
187.23015
|
5.1474553
|
255.18
|
256.12
|
255.6420
|
-0.0000500
|
0.1144111
|
0.5969261
|
|
2017-12-21
|
232.49260
|
-138.30495
|
94.187646
|
95.18190
|
5.7176805
|
261.01
|
256.12
|
255.6663
|
0.0002105
|
0.1203810
|
0.6962998
|
|
2017-12-22
|
222.55065
|
-107.00116
|
115.549498
|
118.48262
|
5.5107281
|
258.97
|
256.12
|
255.3694
|
-0.0010556
|
0.1228965
|
0.6852494
|
|
2017-12-26
|
235.43117
|
-70.69340
|
164.737772
|
164.73777
|
3.1683852
|
257.72
|
269.03
|
256.8571
|
0.0018571
|
0.1244430
|
0.4022834
|
|
2017-12-27
|
149.65258
|
10.85251
|
160.505091
|
160.50509
|
0.7960612
|
255.95
|
268.14
|
257.3533
|
0.0019524
|
0.0959786
|
0.0844049
|
|
2017-12-28
|
198.89344
|
-17.43462
|
181.458827
|
181.45883
|
0.8937680
|
256.50
|
268.14
|
257.4235
|
0.0024000
|
0.1029339
|
0.0999990
|
|
2017-12-29
|
59.49473
|
79.87808
|
139.372816
|
139.37282
|
1.1329398
|
254.76
|
268.14
|
257.4721
|
0.0024211
|
0.0892215
|
0.1090826
|
|
2018-01-02
|
-308.80497
|
314.63071
|
5.825741
|
90.05975
|
-0.6058037
|
255.67
|
272.23
|
259.9432
|
0.0030909
|
0.0518000
|
-0.0233806
|
|
2018-01-03
|
221.18366
|
-625.92119
|
-404.737529
|
488.74674
|
-3.2998058
|
253.29
|
260.04
|
260.1418
|
0.0008636
|
0.0671042
|
-0.2134307
|
|
2018-01-04
|
223.80131
|
-878.58409
|
-654.782785
|
751.21048
|
-2.8776041
|
256.83
|
260.04
|
260.4681
|
0.0013333
|
0.1149614
|
-0.3228134
|
|
2018-01-05
|
216.73966
|
-820.74671
|
-604.007054
|
698.35992
|
-2.7324602
|
255.52
|
260.04
|
260.6500
|
0.0007000
|
0.1047276
|
-0.2781640
|
|
2018-01-08
|
226.99296
|
-717.95016
|
-490.957200
|
565.11316
|
-3.4482601
|
251.81
|
257.10
|
260.1086
|
0.0004091
|
4.1513772
|
-14.3070284
|
|
2018-01-09
|
235.04055
|
-675.11801
|
-440.077454
|
506.39067
|
-3.6957450
|
253.94
|
246.35
|
259.8605
|
-0.0008182
|
1.8943881
|
-6.9931753
|
|
2018-01-10
|
234.37942
|
-689.31819
|
-454.938769
|
510.65330
|
-3.9136773
|
254.33
|
249.30
|
259.6495
|
-0.0006364
|
1.0960271
|
-4.2814965
|
|
2018-01-11
|
235.13630
|
-637.13524
|
-401.998937
|
460.96559
|
-3.8721516
|
255.13
|
249.30
|
259.9029
|
-0.0007619
|
1.0314277
|
-3.9858445
|